home *** CD-ROM | disk | FTP | other *** search
/ NeXT Education Software Sampler 1992 Fall / NeXT Education Software Sampler 1992 Fall.iso / Programming / Source / winterp-1.13 / examples / radiobox2.lsp < prev    next >
Encoding:
Lisp/Scheme  |  1991-10-06  |  3.0 KB  |  87 lines
  1. ; -*-Lisp-*-
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;
  4. ; File:         radiobox2.lsp
  5. ; RCS:          $Header: radiobox2.lsp,v 1.2 91/10/05 18:48:05 mayer Exp $
  6. ; Description:  A better (?) way of creating a radio box, using subclassing of
  7. ;               togglebutton. Note that this version doesn't waste as much
  8. ;               memory as radiobox1.lsp because it defines a single
  9. ;               entry-callback on the rowcolumn widget instead of forcing each
  10. ;               toggle-button to have separate copies of very similar
  11. ;               callback-closures. Just load this file to see the example.
  12. ; Author:       Niels Mayer, HPLabs
  13. ; Created:      Sat Nov 25 01:24:00 1989
  14. ; Modified:     Sat Oct  5 18:47:37 1991 (Niels Mayer) mayer@hplnpm
  15. ; Language:     Lisp
  16. ; Package:      N/A
  17. ; Status:       X11r5 contrib tape release
  18. ;
  19. ; WINTERP Copyright 1989, 1990, 1991 Hewlett-Packard Company (by Niels Mayer).
  20. ; XLISP version 2.1, Copyright (c) 1989, by David Betz.
  21. ;
  22. ; Permission to use, copy, modify, distribute, and sell this software and its
  23. ; documentation for any purpose is hereby granted without fee, provided that
  24. ; the above copyright notice appear in all copies and that both that
  25. ; copyright notice and this permission notice appear in supporting
  26. ; documentation, and that the name of Hewlett-Packard and Niels Mayer not be
  27. ; used in advertising or publicity pertaining to distribution of the software
  28. ; without specific, written prior permission.  Hewlett-Packard and Niels Mayer
  29. ; makes no representations about the suitability of this software for any
  30. ; purpose.  It is provided "as is" without express or implied warranty.
  31. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  32.  
  33. (setq toplevel_w
  34.       (send TOP_LEVEL_SHELL_WIDGET_CLASS :new 
  35.         :XMN_GEOMETRY "500x500+1+1"
  36.         :XMN_TITLE "Radio-Box-Test #2"
  37.         :XMN_ICON_NAME "Radio-Box-Test #2"
  38.         ))
  39.  
  40. (setq rowcol_w
  41.       (send XM_ROW_COLUMN_WIDGET_CLASS :new :managed :radio_box "rc" toplevel_w
  42.         ))
  43.  
  44. (send toplevel_w :realize)
  45.  
  46. (send rowcol_w :set_callback :xmn_entry_callback
  47.        '(CALLBACK_ENTRY_WIDGET
  48.      CALLBACK_ENTRY_SET)
  49.        '(
  50.      (if CALLBACK_ENTRY_SET
  51.          (send CALLBACK_ENTRY_WIDGET :print-which-button)
  52.        )
  53.      ))
  54.  
  55. ;; make a subclass of XM_TOGGLE_BUTTON_GADGET_CLASS
  56. (setq My_Toggle_Button            
  57.       (send Class :new
  58.         '(button_name)        ;a new ivar for this subclass
  59.         '()                ;no class variables for subclass
  60.         XM_TOGGLE_BUTTON_GADGET_CLASS)) 
  61.  
  62. ;; override XM_TOGGLE_BUTTON_GADGET_CLASS's instance initializer
  63. (send My_Toggle_Button :answer :isnew '(name &rest args)
  64.       '(
  65.     (setq button_name name)
  66.     (apply 'send-super `(:isnew ,@args
  67.                     :xmn_label_string ,name))
  68.     ))
  69.  
  70. ;; add a method that prints which button
  71. (send My_Toggle_Button :answer :print-which-button '()
  72.       '(
  73.     (format T "option ~A selected\n" button_name)
  74.     ))
  75.  
  76.  
  77. (do* 
  78.  (;; local vars
  79.   (i 0 (1+ i))
  80.   )
  81.  (;; test and return
  82.   (eql i 20)
  83.   )
  84.  ;; body
  85.  (send My_Toggle_Button :new (format nil "Button ~A" i) :managed rowcol_w)
  86.  )
  87.